home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
self
/
contrib.lha
/
contrib
/
SelfNews
/
wireIPS.cps
< prev
Wrap
Text File
|
1993-07-24
|
4KB
|
160 lines
% File wireIPS.cps
% created by Ian Wilkinson on Sat Sep 12 22:51:33 1992
%
% Copyright (c) Canon Research Centre Europe, 1992.
% All rights reserved.
cdef PSloadPackages()
/NeWS 3 0 findpackage beginpackage
/TNTCore 3 0 findpackage beginpackage
/TNT 3 0 findpackage beginpackage
/ClassGeneric nullarray
dictbegin
/offsetX 0 def
/offsetY 0 def
dictend
classbegin
/methoddict { % [ argNames ] [ localNames ] => dict
0
2 index {
dup null eq {
pop
}{
/promoted? self send not { 1 add } if
} ifelse
} forall
1 index length add dict
begin
{ null def } forall
arrayreverse {
dup null eq {
pop pop
}{
dup /promoted? self send
{ exch store } { exch def } ifelse
} ifelse
} forall
currentdict
end
} def
/methodstacktodict { % [ argNames ] => -
arrayreverse {
dup null eq {
pop pop
}{
dup /promoted? self send { exch store } { exch def } ifelse
} ifelse
} forall
} def
/containingWindow { % - => canvas
[] [ /can ] methoddict
begin
/parents self send {
/can exch store
can /descendantof? ClassWindow send { exit } if
} forall
can framebuffer eq { null }{ can } ifelse
end
} def
/installStdBehaviour { % - => -
[] [ /theMenu ] methoddict
begin
true /setdamageable self send
true /settrackable self send
true /setfrontable self send
true /setmenuable self send
/theMenu /Grid framebuffer /new ClassMenu send store
[
[ (Quit) /removeFromWorld ]
] /setitemlist theMenu send
self /settarget theMenu send
theMenu /setmenu self send
/TrackStart { % evt => /Default true
[ /evt ] [] methoddict
begin
/totop self send
gsave
self setcanvas
evt /Coordinates get aload pop
/offsetY exch store
/offsetX exch store
grestore
/Default true
end
} /installmethod self send
/TrackMotion { % evt => -
/Coordinates get aload pop offsetX offsetY xysub
/move self send
} /installmethod self send
end
} def
/messageSyncSelf { % [ args ... ] methodName object => -
[ /args /methodName /obj ] [ /wireProcF ] methoddict
begin
shareddict /MessageSelfProt get {
/wireProcF wireProcess /Stdout get store
wireProcess /Stdout shareddict /MessageSelf get put
args methodName obj wiresendsync
wireProcess /Stdout wireProcF put
} monitor
end
} def
/messageSelf { % [ args ... ] methodName object => -
[ /args /methodName /obj ] [] methoddict
begin
shareddict /MessageSelfProt get {
%%CHANGE. Terrible hack.
wireProcess
/wireProcess
{} fork dup suspendprocess
dup /Stdout shareddict /MessageSelf get put
store
args methodName obj wiresend
/wireProcess exch store
} monitor
end
} def
/removeFromWorld { % cntl => -
/unmap self send %%CHANGE. Find remaining reference.
[] /QuitApp self messageSelf
pop EventMgr /destroy self send /destroy exch send
} def
/vieForAttention { % - => -
/totop self send
} def
classend def
cdef PSsend( postscript psFragment )
psFragment
cdef PSsendTo( token tk, postscript psFragment )
psFragment tk send
cdef PSsyncReply( int tk, postscript theReply )
[ theReply ] /wireresume tk shareddict /MessageMachine get getfileinputtoken send
#define JotViewAspects 2000
cdef PSjotViewAspects( token tk ) => JotViewAspects( )
JotViewAspects tagprint
/wire_Tags tk send length typedprint
#define JotViewBehaviour 2001
cdef PSjotViewBehaviour( token tk ) => JotViewBehaviour( )
JotViewBehaviour tagprint
/wire_Tags tk send dup length typedprint
{ typedprint pop } forall